home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Die Speccy' 97
/
Die Speccy' 97.iso
/
amiga_system
/
the_aminet
/
comm
/
bbs
/
bbbbs85.lha
/
rexx
/
bbsOther.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-12-21
|
8KB
|
379 lines
/* bbsOther.rexx 8.3 (21.12.94)
copyright ⌐ 1994 Richard Lee Stockton
BBBBS display available info about users
FREELY DISTRIBUTABLE
*/
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E
SIGNAL ON FAILURE
SIGNAL ON SYNTAX
PARSE SOURCE . . . prg .
ADDRESS AREXX Increment.rexx prg
PARSE ARG maxtime name sysoplevel real bbspath bbsname
IF ADDRESS()='BAUD' THEN
DO
CR='0D'x
frombb=1
END
ELSE
DO
CR=''
frombb=0
END
lineup='1B'x'M'
userfile=bbspath'Users/'name
CALL OPEN(f,userfile,'R')
data.=''
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
data.i=line
END
CALL CLOSE(f)
data.0=i-1
IF frombb THEN linesperpage=data.7
ELSE linesperpage=20
clr=''
IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
colorflag=1
IF FIND(data.8,'COLOR')=0 THEN colorflag=0
IF colorflag THEN
DO
def=''
bak2='
'
pen3='
'
END
ELSE
DO
def=''
pen3=''
bak2=''
END
level=data.20
oprompt='['pen3'D'def']etails or simple ['pen3'N'def']amelist or'
oprompt=oprompt '['pen3'Q'def']uit'
IF level>sysoplevel THEN oprompt=oprompt '['pen3'R'def']eport? (Dnqr) > '
ELSE oprompt=oprompt||'? (Dnq) > '
DO FOREVER
CALL others()
END
EXIT
others:
line=''
nonstop=0
temp=getinput(1 1 oprompt)
IF temp='Q' THEN EXIT
IF temp='N' THEN
DO
CALL showuserlist()
RETURN
END
ELSE IF level>sysoplevel & temp='R' THEN
DO
SAY CR
line=''
IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
DO
CALL cleanline(0)
SAY 'INACTIVE_USERS report will be in your email.'CR
line='USERS '
END
IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
DO
CALL cleanline(0)
line=line'FILES'
SAY 'Entering -1 at the next prompt will disable the least popular report.'CR
line=STRIP(line getinput(1 0 'Report least popular files larger than (0) bytes > '))
SAY 'FILELISTS_REPORT will be in your email.'CR
END
SAY CR
ADDRESS AREXX bbsREPORT.rexx name line
RETURN
END
SAY CR
SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
SAY CR
SAY 'User specification may include ? wildcard for single characters.'CR
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' | arg='Q' THEN EXIT
arg=TRANSLATE(STRIP(arg),'_',' ')
SAY 'Searching ...'lineup||CR
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'CR
IF wildlist.0<1 THEN RETURN
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
DO
IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
extrainfo=1
END
DO i=1 TO wildlist.0
CALL readlines(wildlist.i 1)
SAY CR
totlines=totlines+6
SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
IF real THEN SAY lynes.1||CR
IF FIND(UPPER(lynes.8),'STREET')>0 THEN
DO
totlines=totlines+1
SAY lynes.2||CR
END
SAY lynes.3||CR
IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
DO
totlines=totlines+1
SAY lynes.4||CR
END
SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
SAY pen3'Interests:'def lynes.10||CR
IF extrainfo THEN
DO
SAY pen3' up:'def lynes.14||CR
SAY pen3' down:'def lynes.15||CR
temptot=0
DO j=1 TO WORDS(lynes.23)
IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
END
SAY pen3' writ:'def temptot 'public messages.'CR
SAY pen3'level:'def lynes.20||CR
totlines=totlines+4
IF lynes.21~='' THEN
DO
totlines=totlines+1
SAY pen3'excluded dirs:'def lynes.21||CR
END
END
IF nonstop~=1 & totlines>=nextpagebreak THEN
DO
IF waiting2() THEN LEAVE i
nextpagebreak=totlines+linesperpage-5
END
END
IF waitchar~='Q' THEN CALL waiting()
RETURN
checktime:
IF ~frombb THEN RETURN
IF TIME('E')>maxtime THEN EXIT
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||'
'||'
'||' 'name' level 'level' '||'
'
CALL checkdcd()
RETURN
waiting:
CALL checktime()
IF waitchar='Q' THEN
DO
waitchar=''
RETURN
END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3' RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
CALL checkdcd()
RETURN
waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3' Q=Quit N=Non-Stop RETURN=Continue 'def)
IF waitchar='N' THEN
DO
nonstop=1
SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E 'def||CR
SAY CR
CALL DELAY(99)
waitchar=''
END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0
readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line||CR
RETURN 0
readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
line=READLN(f)
IF EOF(f) THEN BREAK
lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0
cleanline:
ARG lflag .
IF nonstop=0 & clr~='' & frombb THEN
DO
Send clr
RETURN
END
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN
getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(inarg)
RETURN inarg
checkdcd:
IF ~frombb THEN RETURN
dcd
IF RC=0 THEN
DO
DO dcds=1 TO 3 /* 5 second delay */
CALL DELAY(50)
dcd
IF RC~=0 THEN RETURN
END
dcd
IF RC=0 THEN EXIT
END
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & xmsg~='' THEN
DO
CALL SETCLIP('BBS_MESSAGE')
SAY CR
SAY bak2' Message From BBBBS: 'def||CR
SAY xmsg||CR
SAY CR
CALL waiting()
END
IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
RETURN
cleanstring:
PARSE ARG cstr
bot=XRANGE(,'1F'x)
cstr=strip_ansi(cstr)
top=XRANGE('7F'x)
cstr=COMPRESS(cstr,bot||top)
cstr=STRIP(cstr)
RETURN cstr
strip_ansi:
PARSE ARG aline
n=POS('1B'x,aline)
DO WHILE n>0
DO k=2
IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
leave k
END
aline=DELSTR(aline,n,k+1)
n=POS('1B'x,aline)
END
RETURN aline
seelines:
ARG fancy .
DO i=1 TO lynes.0
IF fancy=0 THEN SAY lynes.i||def||CR
ELSE
DO
IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
SAY pen3||lynes.i||def||CR
ELSE SAY lynes.i||CR
END
IF i//linesperpage=0 & i<lynes.0 THEN
IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN
showtext:
PARSE ARG starg .
IF EXISTS(starg) THEN
DO
CALL readlines(starg 1)
CALL seelines(1)
nonstop=0
CALL waiting()
END
RETURN
showuserlist:
line=' 'WORDS(SHOWDIR(bbspath'Users')) 'users. Use these names to address messages.'
SAY pen3||line||def||CR
CALL showtext(bbspath'Lists/USERS')
CALL waiting()
RETURN
BREAK_E:
i=999999
ri=999999
RETURN
BREAK_C:
EXIT
FAILURE:
SYNTAX:
lin.1='
'ERRORTEXT(RC)'
'
lin.2=SIGL-1 SOURCELINE(SIGL-1)
lin.3=SIGL '
'SOURCELINE(SIGL)'
'
lin.4=SIGL+1 SOURCELINE(SIGL+1)
DO er=1 TO 4
SAY 'bbsOther:' lin.er||CR
END
EXIT
/* bbsOther.rexx */